home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)TB / (A)TBK.ADF / Ont_Tax_'90 / tax90v1 < prev    next >
Text File  |  1991-02-09  |  12KB  |  488 lines
  1. REM tax90v1.0 feb11/91
  2. 1 DATA = ontario tax retrn =,$1990
  3. 2 DATA ...jim butterfield...,c0;0
  4. 3 DATA ====page 1====,c0
  5. 4 DATA income from emplyment,#1;z2;i2
  6. 5 DATA pension income,i2
  7. 6 DATA family allowance,i2
  8. 7 DATA divds tax cadn corpns,#3;i2
  9. 8 DATA other income,i2
  10. 9 DATA total income,#5;c3;s2
  11. 10 DATA ====step 3====,c0
  12. 11 DATA total income,c3;v5
  13. 12 DATA reg pension contr,z3;i3
  14. 13 DATA union/prof dues,i3
  15. 14 DATA carrying charges,i3
  16. 15 DATA other deductions,i3
  17. 16 DATA total deductions,#6;c4;s3
  18. 17 DATA net income,#7;c4;v5-v6
  19. 18 DATA total dedns net inc,z3;i3
  20. 19 DATA taxable income,#8;c4;v7-s3
  21. 20 DATA ====step 4====,c0
  22. 21 DATA personal credit,z3;c3;6169
  23. 22 DATA age credit,i3[3327
  24. 23 DATA credit for spouse,i3[5141
  25. 24 DATA credit for children,i3
  26. 25 DATA cpp contributions,i3[574.20
  27. 26 DATA uic contributions,i3[748.80
  28. 27 DATA total medical expses,#13;i2
  29. 28 DATA ..less 3% n.i.,#14;(v13>0);v7%3[1517;c2
  30. 29 DATA allowable medicl exp,(v13>0);v13-v14]0;c3
  31. 30 DATA other credits,i3
  32. 31 DATA line 335,#9;c4;s3[v8:REM guide confusing
  33. 32 DATA tax credits,#10;z4;c4;v9%17
  34. 33 DATA charitable donations,#11;i2
  35. 34 DATA credit at 17%,(v11>0);c4;v11[250%17
  36. 35 DATA credit at 29%,(v11>250);c4;v11-250]0%29
  37. 36 DATA total tax credits,#12;s4;c4
  38. 37 DATA =====schedule  1===,c0
  39. 38 DATA brckt,#15;v8;x;56550;28275;0
  40. 39 DATA ..on first,v15;c1
  41. 40 DATA ..tax is,#16;c2;y;12158;4807;0
  42. 41 DATA ..on remaining,#17;c1;v8-v15
  43. 42 DATA ..tax at percent..,#18;c1;y;29;26;17
  44. 43 DATA ..gives,#19;c2;v17%v18
  45. 44 DATA total,#20;c3;v16+v19
  46. 45 DATA total nr tax credit,v12;z3;c3
  47. 46 DATA divd tax credit,c3;v3%40/3[v20
  48. 47 DATA total credits,#21;c4;s3
  49. 48 DATA basic federal tax,#22;c4;v20-v21]0
  50. 49 DATA forgn tax deductions,#23;i3
  51. 50 DATA federal tax,#24;c4;v22-v23
  52. 51 DATA surtax at 5%,z3;(v22>0);c3;v22%5
  53. 52 DATA surtax at 3%,(v22>15000);c3;v22-15000]0%3
  54. 53 DATA indiv surtax payable,#28;c4;s3
  55. 54 DATA ===ontario tax===,0
  56. 55 DATA basic ontario tax,#30;c3;v22%53
  57. 56 DATA ontario surtax,#31;c3;v30-10000]0%10
  58. 57 DATA adjusted tax,#32;c4;v30+v31
  59. 58 DATA ..ont tax reduction.,c0;0
  60. 59 DATA # dependents,#62;i1
  61. 60 DATA basic amount,z3;c3;167
  62. 61 DATA plus dependents,(v62>0);c3;v62*200
  63. 62 DATA totl pers amt,#63;c3;s3
  64. 63 DATA b times 3,#64;c2;v63*3
  65. 64 DATA a times 2,#65;c2;v32*2
  66. 65 DATA ont tax redctn,#66;c4;v64-v65]0
  67. 66 DATA ontario tax,#36;c4;v32-v66]0
  68. 67 DATA == ont tax credits==,c0
  69. 68 DATA ontario tax credits,#50;i4
  70. 69 DATA ..complete form t1c,(v50>0);c0;0
  71. 70 DATA ..spouse incm needd,(v50>0);c0;0
  72. 71 DATA ===step 5===,c0
  73. 72 DATA federal tax,c4;v24]0
  74. 73 DATA federal tax credits,#51;i3
  75. 74 DATA fed tax line 417,#52;c4;v24-v51]0
  76. 75 DATA indiv surtax payabl,c4;v28
  77. 76 DATA net federal tax,#53;c4;v52+v28
  78. 77 DATA ontario tax payable,#54;c3;v36
  79. 78 DATA total payable,#55;c4;v53+v54
  80. 79 DATA child tax credit,z3;i3
  81. 80 DATA fed sales tax credt,i3
  82. 81 DATA ....do schedule 7..,(s3>0);c0;0
  83. 82 DATA spouse incm needed.,(s3>0);c0;0
  84. 83 DATA ontario tax credits,c3;v50
  85. 84 DATA tax deducted /slips,i3
  86. 85 DATA other credits,i3
  87. 86 DATA total credits,#58;c4;s3
  88. 87 DATA x,#59;v55-v58;(v58>v55);v58-v55
  89. 88 DATA x,$;----------
  90. 89 DATA * no balance *,#60;1;(v59<1);c0;0
  91. 90 DATA x,#61;v60;(v58>v55);2*v60
  92. 91 DATA * refund due *,(v61=2);c2;v59
  93. 92 DATA * balance payable *,(v61=1);c2;v59
  94. DATA end,end,end
  95.  
  96. REM: **** r u g  -  report utility generator ****
  97. REM: command lines... ( c$(.) )
  98. REM:   a series of commands, each of which is separated
  99. REM:           by a semicolon;
  100. REM:   line starting with # identifies variable line.
  101. REM:   line starting with $ is special titling line.
  102. REM: commands...
  103. REM:   may be an expression (see below), or:
  104. REM:   c# - print in column  (#=0 to 4, 0=no print)
  105. REM:   z# - clear column total (#=1 to 4)
  106. REM:   t# - print column total (#=1 to 4)
  107. REM:    (z or t may have multiples, e.g., z1234)
  108. REM:   j# - jump to specified line
  109. REM: expressions...
  110. REM:   (parentheses for test)  .. continue line if true (<>0)
  111. REM:   following may be mixed using operators (below)
  112. REM:     numeric values;
  113. REM:     i# for keyboard input (# is column);
  114. REM:     s# for column total   (# is column);
  115. REM:     v# for variable value;
  116. REM:     n   gets yes/no value
  117. REM:  operators (left-to-right evaluation):
  118. REM:   + addition   - subtraction
  119. REM:   * multiply   / divide
  120. REM:   % percentage (multiply)
  121. REM:   [ smaller of      ] greater of
  122. REM:   (example:  22[7 returns 7)
  123. REM:   > < = comparisons:  yield 0 (not true) or 1 (true)
  124. REM:   comparisons may be used multiply, e.g., v5<=100
  125. REM: examples...
  126. REM:      i3+100[500
  127. REM:   input value, add 100, if over 500 set to 500
  128. REM:   print result in column3
  129. REM:      c3;v12%10[100
  130. REM:   take 10% of value 12 (line 12) minimum 100
  131. REM:   and print in column 3
  132. REM:      500;(v15>1000);v15/2
  133. REM:   value 500; or if value 15 is greater than 1000
  134. REM:      set value v15/2.  do not print (no 'c' set).
  135. CLS
  136. PRINT " ."
  137. Ll=0
  138. FOR j=5 TO 6
  139.  FOR k=11 TO 12
  140.   Ll=Ll+POINT(k,j)
  141.  NEXT k
  142. NEXT j
  143. IF Ll=4 THEN Ll=80 ELSE Ll=60
  144. PRINT "Please wait..."
  145. PRINT
  146. PRINT "When prompted, you may enter:"
  147. PRINT "    [RETURN] (for 'zero' input);"
  148. PRINT "    numeric value <return>;"
  149. 'PRINT "    numeric value   +  "
  150. 'PRINT "      (to have items totalled);
  151. PRINT "    [F1][RETURN]   (to review or change data)."
  152. PRINT
  153. PRINT "Ontario income tax"
  154. PRINT
  155. PRINT "This program does not give tax advice"
  156. PRINT "  ..just helps with the arithmetic."
  157. PRINT
  158. PRINT "This is *not* the computer tax format"
  159. PRINT "accepted for filing by Revenue Canada."
  160. PRINT
  161. PRINT "Some tax calculations call for spouse's income"
  162. PRINT " .. not detailed in this program."
  163. PRINT
  164. DIM i$(200),i%(200),v&(200),c$(200),c%(4),t&(4)
  165. c%(1)=1:c%(2)=2:c%(3)=4:c%(4)=8
  166. READ i$
  167. j=0
  168. WHILE i$<>"end"
  169.  j=j+1
  170.  READ c$
  171.  L0=1
  172.  IF LEFT$(c$,1)="#" THEN
  173.   L0=INSTR(c$,";")
  174.   t=VAL(MID$(c$,2,L0-1))
  175.   IF i%(t)<>0 GOTO LinErr1
  176.   i%(t)=j:L0=L0+1
  177.  END IF
  178.  i$(j)=i$:c$(j)=MID$(c$,L0)
  179.  READ i$
  180. WEND
  181. PRINT
  182. OPEN "scrn:" FOR OUTPUT AS #4
  183. c1=1
  184.     'Next Item
  185. NxLine:
  186.  WHILE c$(c1)<>"" 
  187.  c0=-1:t3=0:c=c1:c1=c1+1
  188.  IF c$(c)="c0" THEN c9=c
  189.  L0=1:L1=LEN(c$(c))
  190.  InptFlg=0
  191.  IF ASC(c$(c))=36 THEN
  192.       ' $ at start of line
  193.   GOSUB BuckLine
  194.  ELSE
  195.   WHILE L0<=L1
  196.    L2=INSTR(MID$(c$(c),L0),";")
  197.    IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  198.    ComdLen=L2-L0
  199.    t=ASC(MID$(c$(c),L0)):IF t>96 THEN t=t-32
  200.    IF t=67 OR (PrtFlg AND t=73) THEN  ' c or i/print
  201.      REM: c - set column value
  202.      c0=VAL(MID$(c$(c),L0+1,ComdLen-1)):e=(c0>4):IF e GOTO LinErr1
  203.      c0=c%(c0)
  204.    ELSEIF t=40 THEN     '  REM (
  205.     REM: (..) evaluate and continue/quit
  206.     e=ASC(MID$(c$(c),L2-1))<>41:IF e GOTO LinErr1
  207.     e=(L2-L0)<3:IF e GOTO LinErr1
  208.     L8=L0+1:L9=L2-1:GOSUB Eval
  209.     IF v#=0 THEN L2=L1  'exit
  210.    ELSEIF t=74 THEN     '  REM j
  211.     REM: j - jump to line
  212.     v=VAL(MID$(c$(c),L0+1,ComdLen-1))
  213.     c1=i%(v)
  214.     L2=L1  'exit
  215.    ELSEIF PrtFlg THEN
  216.     ' pass 2 .. don't calculate
  217.    ELSEIF t=88 THEN     '  REM x
  218.     REM x - table lookup
  219.     y=0:v0#=v&(c)/100#:v#=v0#+1#
  220.     L0=L2+1
  221.     WHILE v#>v0# AND L0<=L1
  222.      y=y+1
  223.      L2=INSTR(MID$(c$(c),L0),";")
  224.      IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  225.      ComdLen=L2-L0
  226.      v#=VAL(MID$(c$(c),L0,ComdLen))
  227.      L0=L2+1
  228.     WEND
  229.     v&(c)=INT(v#*100#+.5#)
  230.     L2=L1    'exit
  231.    ELSEIF t=89 THEN    '  REM y
  232.     REM y - table usage
  233.     y1=0
  234.     L0=L2+1
  235.     WHILE y1<y AND L2<L1
  236.      y1=y1+1
  237.      L2=INSTR(MID$(c$(c),L0),";")
  238.      IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  239.      ComdLen=L2-L0
  240.      v#=VAL(MID$(c$(c),L0,ComdLen))
  241.      L0=L2+1
  242.     WEND
  243.     v&(c)=INT(v#*100#+.5#)
  244.     L2=L1   'exit
  245.    ELSEIF t=84 OR t=90 THEN
  246.       '  T/Z multiple column functions
  247.     c8=c0:c0=0
  248.     FOR j=L0+1 TO L2-1
  249.      t0=VAL(MID$(c$(c),j,1))
  250.      c0=c0 OR c%(t0)
  251.     NEXT j
  252.     IF t=90 THEN
  253.      FOR j=1 TO 4
  254.       IF (c0 AND c%(j))<>0 THEN t&(j)=0
  255.      NEXT j
  256.      c0=c8
  257.     ELSE
  258.      t3=1
  259.     END IF
  260.    ELSE
  261.     GOSUB SeekVal
  262.     IF t0 AND NOT InptFlg THEN
  263.      L8=L0:L9=L2:GOSUB Eval
  264.      IF ASC(RIGHT$(" "+v$,1))=129 GOTO Revise 
  265.     END IF
  266.     IF t0=0 GOTO LinErr0
  267.     v&(c)=INT(v#*100+.5)
  268.    END IF
  269.    L0=L2+1
  270.   WEND
  271.   GOSUB Echo
  272.  END IF
  273. WEND
  274.  
  275. REM: end of control strings
  276. IF PrtFlg=0 THEN
  277.  IF c9=0 GOTO AskPrint
  278.  INPUT "want to revise this";x$
  279.  x$=UCASE$(x$)
  280.  IF x$="Y" OR x$="YES" GOTO Revise
  281. AskPrint: 
  282.  CLOSE 4:INPUT "want a printout";x$
  283.  x$=UCASE$(x$)
  284.  IF x$="Y" OR x$="YES" THEN
  285.   c1=1:OPEN "prt:" FOR OUTPUT AS #4:Ll=80:InptFlg=0:PrtFlg=-1
  286.   GOTO NxLine
  287.  END IF
  288. END IF
  289. PRINT ">>> end <<<"
  290. END
  291.  
  292.    ' revision time
  293. Revise:
  294.  IF c9>0 THEN
  295.   PRINT:r=0
  296.   FOR j=1 TO c9
  297.    IF c$(j)="c0" THEN r=r+1:PRINT r;">>> ";i$(j)
  298.   NEXT j
  299.   r1=1
  300.   IF r>1 THEN
  301.     PRINT "go back to which one (1 to";r;")";
  302.     INPUT r1
  303.   END IF
  304.   IF r1>0 AND r1<=r THEN
  305.    r=0
  306.    FOR j=1 TO c9
  307.     IF c$(j)="c0" THEN r=r+1:IF r=r1 THEN c=j
  308.    NEXT j
  309.   END IF
  310.  END IF
  311.  c1=c:GOTO NxLine
  312.  
  313. LinErr0:
  314.  PRINT "error item";c;"' ";MID$(c$(c),L0);" '":STOP
  315. LinErr1:
  316.  PRINT "error item";c;"' ";MID$(c$(c),L1);" '":STOP
  317. LinErr2:
  318.  PRINT "error item";c;"' ";MID$(c$(c),L8,L5-L8);" '":STOP
  319.  
  320. REM evaluate
  321. Eval:
  322.  v#=0:OpNow=10
  323.  REM get a command
  324.  WHILE L8<L9
  325.   PtOp2=L8:t0=0
  326.   GOSUB SeekOp
  327.   OpNext=t0
  328.   L5=PtOp1
  329.   e=L5<=L8:IF e GOTO LinErr2
  330.   t=ASC(MID$(c$(c),L8))
  331.   IF t>96 THEN t=t-32
  332.   GOSUB SeekVal
  333.   e=t0=0:IF e GOTO LinErr2
  334.   IF (t>47 AND t<58) OR t=46 THEN
  335.    ' Numeric
  336.    v0#=VAL(MID$(c$(c),L8,L5-L8))
  337.   ELSEIF t=83 OR t=86 THEN
  338.    ' S or V
  339.    v1=VAL(MID$(c$(c),L8+1,L5-L8-1))
  340.    IF t=83 THEN v0#=t&(v1)/100#
  341.    IF t=86 THEN
  342.    e=i%(v1)=0
  343.    IF e THEN PRINT "** no param";v1:GOTO LinErr2
  344.    v0#=v&(i%(v1))/100#
  345.    END IF
  346.   ELSEIF t=78 THEN
  347.       '  Y or N
  348.    e=InptFlg:IF e GOTO LinErr2
  349.    REM: y for yes/no
  350.    WINDOW 2,"[Y] or [N]",(10,10)-(400,30),24
  351.    WINDOW OUTPUT 2
  352.    InptFlg=-1
  353.    PRINT i$(c);"(y/n) ";
  354.    INPUT y$:y$=UCASE$(y$)
  355.    WINDOW CLOSE 2
  356.    v0#=0:IF y$="Y" THEN v0#=1
  357.   ELSE
  358.      'Inpt
  359.    e=InptFlg:IF e GOTO LinErr2
  360.    InptFlg=-1
  361.    c0=VAL(MID$(c$(c),L8+1,L5-L8-1))
  362.    e=(c0<1 OR c0>4)
  363.    IF e GOTO LinErr2
  364.    c0=c%(c0)
  365.    IF v&(c)=0 THEN
  366.     WINDOW 2,i$(c),(10,10)-(400,30),24
  367.    ELSE
  368.     GOSUB DolCents:v$=LEFT$(v$,1)+d$
  369.     IF c$<>"00" THEN v$=v$+".":v$=v$+c$
  370.     WINDOW 2,"[RETURN]="+v$,(10,10)-(400,30),24
  371.    END IF
  372.    WINDOW OUTPUT 2
  373.    PRINT i$(c);"? ";
  374.    LINE INPUT v$
  375.    IF v$<>"" THEN
  376.     v0#=VAL(v$)
  377.    ELSE
  378.     v0#=v&(c)/100#
  379.    END IF
  380.    WINDOW CLOSE 2
  381.    IF ASC(RIGHT$(" "+v$,1))=129 THEN RETURN
  382.   END IF
  383.   '  perform dyadic operation
  384.   ON OpNow GOSUB lt,eq,le,gr,ne,ge,br,pct,ml,ad,sb,div,flr,cei
  385.   OpNow=OpNext:L8=PtOp2
  386.  WEND
  387. RETURN
  388.  
  389. ad: v#=v#+v0#
  390.     RETURN
  391. sb: v#=v#-v0#
  392.     RETURN
  393. ml: v#=v#*v0#
  394.     RETURN
  395. div: v#=v#/v0#
  396.     RETURN
  397. pct: v#=v#*v0#/100#
  398.     RETURN
  399. flr: IF v#>v0# THEN v#=v0#
  400.     RETURN
  401. cei: IF v#<v0# THEN v#=v0#
  402.     RETURN
  403. lt: v#=-(v#<v0#)
  404.     RETURN
  405. eq: v#=-(v#=v0#)
  406.     RETURN
  407. le: v#=-(v#<=v0#)
  408.     RETURN
  409. gr: v#=-(v#>v0#)
  410.     RETURN
  411. ne: v#=-(v#<>0#)
  412.     RETURN
  413. ge: v#=-(v#>=0#)
  414.     RETURN
  415. br: v#=1
  416.     RETURN
  417.  
  418. Echo:
  419.  IF c0>=0 THEN
  420.   PRINT#4,LEFT$(i$(c)+SPACE$(21),21);" ";
  421.    IF c0>=1 THEN
  422.     FOR j=1 TO 4
  423.      IF (c0 AND c%(j))=0 THEN
  424.       IF Ll>60 OR j<>1 THEN PRINT#4,SPACE$(12);
  425.      ELSE
  426.       IF t3=0 THEN
  427.        t&(j)=t&(j)+v&(c)
  428.       ELSE
  429.        v&(c)=t&(j):t&(j)=0
  430.       END IF
  431.       GOSUB DolCents
  432.       cr$="  ":IF LEFT$(v$,1)="-" THEN cr$="cr"
  433.       d$=RIGHT$(SPACE$(6)+d$,6):cm$=MID$(d$,3,1)
  434.       IF cm$<>" " THEN cm$=","
  435.       PRINT#4,LEFT$(d$,3);cm$;MID$(d$,4);".";c$;cr$;
  436.      END IF
  437.     NEXT j
  438.    END IF 
  439.    PRINT#4,
  440.   END IF
  441. RETURN
  442.  
  443. DolCents:
  444.  v$=STR$(v&(c)):IF LEN(v$)<3 THEN v$=LEFT$(v$,1)+"0"+RIGHT$(v$,1)
  445.  c$=RIGHT$(v$,2):d$=MID$(v$,2,LEN(v$)-3)
  446.  IF LEN(d$)>6 THEN d$="******"
  447. RETURN
  448.  
  449.  REM: dollars line
  450. BuckLine:
  451.  PRINT#4,LEFT$(i$(c)+SPACE$(21),21);" ";
  452.  L0=2
  453. WHILE L0<=L1
  454.  L2=INSTR(MID$(c$(c),L0),";")
  455.  IF L2=0 THEN L2=L1+1 ELSE L2=L2+L0-1
  456.  ComdLen=L2-L0
  457.  IF L2>0 THEN PRINT#4,RIGHT$(SPACE$(10)+MID$(c$(c),L0,ComdLen),10);"  ";
  458.  IF L2=0 THEN PRINT#4,SPACE$(12);
  459.  L0=L2+1
  460. WEND
  461.  PRINT#4,
  462. RETURN
  463.  
  464.       ' value types
  465. SeekVal:
  466.  t0=INSTR("0123456789.IVSN",CHR$(t))
  467. RETURN
  468.       ' operators and comparison groups
  469. SeekOp:
  470.   PtOp1=0
  471.   t0=0
  472.   t2=0
  473.  WHILE PtOp2<L9 AND ((t0=0 AND PtOp1=0) OR (t0<>0 AND PtOp1<>0))
  474.   PtOp2=PtOp2+1
  475.   t1=t0
  476.   t0=INSTR("<==>===%*+-/[]",MID$(c$(c),PtOp2,1))
  477.   t2=t2 OR t0
  478.   IF t0<>0 AND PtOp1=0 THEN PtOp1=PtOp2
  479.  WEND
  480.  IF t1=t2 THEN
  481.   t0=t1
  482.  ELSE
  483.   IF t2<8 THEN t0=t2
  484.  END IF
  485.  IF PtOp1=0 THEN PtOp1=L9
  486. RETURN
  487. END
  488.